#!/usr/local/bin/perl -w
use strict;
use EV;

use IO::Socket::INET;

my $port = shift || 12345;
my $debug = shift;

# список клиентов
my %client;
# список клиентов ожидающих сообщений
#my %waiting;
my @waiting;
# список входящих сообщений
my @messages;
# число удаленных сообщений из списка
my $shift = 0;
# все ожидающие чтения слушатели
my %readers;
# все ожидающие записи слушатели
my %writers;

my %command = (
	login => \&login,
	check => \&check,
);
my $qr_cmd = join("|", keys %command);
$qr_cmd = qr/^($qr_cmd)\b(.*)/;

# серверный сокет
my $lsn = new IO::Socket::INET(
	    Listen => 100,
	    LocalHost => "127.0.0.1",
	    LocalPort => $port,
	    ReuseAddr => 1,
	);

# слушаем основной сокет
my $w = EV::io $lsn, EV::READ, \&onstream;
EV::loop;

sub ts {
	return sprintf "%02d:%02d:%02d",(localtime)[2,1,0];
}
sub onstream {
	# принимаем подключение
	if($debug){
		print "accept\n";
	}
    my ($watcher, $revents) = @_;
    my $new = $lsn->accept;
    unless($new){
		print "accept failed: $!\n";
		return 0;
    }
    my $nw = EV::io $new, EV::READ, \&onread;
	# сохраняем слушателя, сокет и буфер с принятыми данными
    $readers{int $nw} = [$nw,$new,""];
}
# формат сообщения
# логин: сообщение / чч:мм:сс
# сообщение это или команда из числа фиксированных или просто текст
# команда выполняется, текст рассылается
# одно сообщение на запрос
sub process {
	my ($fh,$str) = @_;
	# проверяем на полноту сообщения по концевому chr(10);
	unless(ord(substr($str,-1,1)) == 10){
		return undef;
	}
	my ($login,$message,$ts);
	unless(($login,$message,$ts) = $str =~ /^(\w+): (.*) \/ (\d{2}:\d{2}:\d{2})\s*$/){
		# неправильное сообщение, просто прекращяем обработку
		return 1;
	}
	# требуется учесть, что после этого сокет будет удален
	# поэтому необходимо его сохранить по необходимости
	# в обработчиках
	if($message =~ $qr_cmd){
		$command{$1}->($fh,$login,$ts,$2);
	}else{
		message($fh,$login,$ts,$message);
	}
	return 1;
}
sub onread{
	# Получили данные
	my ($w, $r) = @_;
	my $ary = $readers{int $w};
	my $buf;
	$ary->[1]->recv($buf,1024);
	if($debug){
		print "read: $buf\n";
	}
	if($buf){
		# есть данные, цепляем к предыдущим если есть
		unless(process($ary->[1], $buf = ($ary->[2] .= $buf))){
			# сообщение не полное, ждем дальше
			return 0;
		}
	}
	# раобота с содинением закончена, закрываем и чистим
	delete $readers{int $w};
	# сокет должен сам закрытся
}
# отсылаем сообщение
sub send_message {
	my ($fh,$str) = @_;
	my $nw = EV::io $fh, EV::WRITE, \&onwrite;
	# создаем слушателя и сохраняем необходимые данные
	$writers{int $nw} = [$nw,$fh,$str];
}
sub onwrite {
	my ($w, $r) = @_;
	my $ary = $writers{int $w};
	my $need = length($ary->[2]);
	if($debug){
		print "write: $ary->[2]\n";
	}
	my $rs = $ary->[1]->send($ary->[2]);
	if($rs){
		$need -= $rs;
		# если отправлено не все, то продолжаем ждать
		if($need > 0){
			substr($ary->[2],0,$rs,"");
			return 0;
		}
	}
	delete $writers{int $w};
}
sub put_message {
	my ($login,$ts,$message) = @_;
	push @messages,$ts." [".$login."] ".$message."\n";
	if(@messages > 20000){
		splice @messages,0,5000;
		$shift += 5000;
	}
	# пройти по всем ожидающим и отправить
	my $current = $shift + @messages;
	# после этого сообщения уже никто не ждет и поэтому
	# они удаляются
	while(my $c = pop @waiting){
		my $last = $client{$c->{login}};
		# отсылаем только последние 1000 сообщений
		if(@messages - ($last -= $shift) > 1000){
			$last = @messages - 100;
		}
		my $str = "";
		for(my $i = $last; $i < @messages; $i++){
			$str .= $messages[$i];
		}
		send_message($c->{fh},$str);
		$client{$c->{login}} = $shift + @messages;
	}
}

sub message {
	my ($fh,$login,$ts,$message) = @_;
	if(exists $client{$login}){
		put_message($login,$ts,$message);
		send_message($fh,"accept ".ts()."\n");
	}else{
		send_message($fh,"reject\n");
	}
}
sub login {
	my ($fh,$login,$ts,$param) = @_;
	# сохраняем последнее сообщение отосланное клиенту
	put_message("system",ts(),"logged ".$login);
	$client{$login} = $shift + @messages;
	send_message($fh,"welcome ".ts()."\n");
}
# вот здесь нужно ждать
sub check {
	my ($fh,$login,$ts,$param) = @_;
	unless(exists $client{$login}){
		send_message($fh,"failed\n");
	}
	# в список ожидающих поступления сообщений нужно сохранить сокет
	my $current = $shift + @messages;
	my $last = $client{$login};
	# проверяем, есть ли новые сообщенияс последней отправки
	if($last < $current){
		# есть
		# отсылаем только последние 1000 сообщений
		if(@messages - ($last -= $shift) > 1000){
			$last = @messages - 100;
		}
		my $str = "";
		for(my $i = $last; $i < @messages; $i++){
			$str .= $messages[$i];
		}
		send_message($fh,$str);
		$client{$login} = $shift + @messages;
	}else{
		# нет
		push @waiting,{fh => $fh, login => $login, ts => $ts};
	}
}
